;;; Guile-GCC --- Guile extension to GCC.               -*- coding: utf-8 -*-
;;; Copyright (C) 2012 Ludovic Courtès
;;;
;;; This file is part of Guile-GCC.
;;;
;;; Guile-GCC is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Guile-GCC is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Guile-GCC.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gcc cpp)
  #:use-module (system foreign)
  #:use-module (ice-9 format)
  #:export (cpp-reader?
            cpp-token?
            token-type
            token-source-location
            get-token
            peek-token
            token-as-text))


;;;
;;; Export constants that were brought to (gcc cpp internal) via C.
;;;

(module-for-each (lambda (sym var)
                   (let ((val (variable-ref var)))
                     (if (integer? val)
                         (begin
                           (module-define! (current-module) sym val)
                           (module-export! (current-module) (list sym))))))
                 (resolve-module '(gcc cpp internal)))


;;;
;;; Bindings to libcpp.
;;;

(define-wrapped-pointer-type cpp-reader cpp-reader?
  wrap-cpp-reader unwrap-cpp-reader
  (lambda (t p)
    (format p "#<gcc cpp-reader ~x (~x)>"
            (object-address t) (object-address (unwrap-cpp-reader t)))))

;; Trick to allow (gcc) to refer to this procedure.
(define %wrap-cpp-reader wrap-cpp-reader)

(define-wrapped-pointer-type cpp-token cpp-token?
  wrap-cpp-token unwrap-cpp-token
  (lambda (t p)
    (format p "#<gcc cpp-token ~x (~x)>"
            (object-address t) (object-address (unwrap-cpp-token t)))))

(define-syntax-rule (cc1-symbol name)             ; FIXME: Deduplicate.
  "Return a `cc1' symbol, taken from the current DSO."
  (dynamic-func name (dynamic-link)))


;;;
;;; Procedures.
;;;

(define (token-type token)
  "Return the type of TOKEN, one of the integral `CPP_' value."
  ((@@ (gcc cpp internal) %token-type) (unwrap-cpp-token token)))

(define (token-source-location token)
  "Return the source location of TOKEN (as an integer suitable for diagnostic
procedures such as `inform')."
  ((@@ (gcc cpp internal) %token-source-location) (unwrap-cpp-token token)))

(define get-token
  (let ((f (pointer->procedure '* (cc1-symbol "cpp_get_token") '(*))))
    (lambda (reader)
      "Return a token from READER."
      (let ((p (f (unwrap-cpp-reader reader))))
        (if (null-pointer? p)
            #f
            (wrap-cpp-token p))))))

(define peek-token
  (let ((f (pointer->procedure '* (cc1-symbol "cpp_peek_token") `(* ,int))))
    (lambda (reader index)
      "Peek the token at INDEX from READER."
      (let ((p (f (unwrap-cpp-reader reader) index)))
        (if (null-pointer? p)
            #f
            (wrap-cpp-token p))))))

(define token-as-text
  (let ((f (pointer->procedure '* (cc1-symbol "cpp_token_as_text") '(* *))))
    (lambda (reader token)
      "Return TOKEN spelt as a string."
      (pointer->string
       (f (unwrap-cpp-reader reader) (unwrap-cpp-token token))))))
